home *** CD-ROM | disk | FTP | other *** search
- Path: uunet!seismo!ut-sally!im4u!rutgers!mit-eddie!uw-beaver!tektronix!tekgen!tekred!games-request
- From: games-request@tekred.TEK.COM
- Newsgroups: comp.sources.games
- Subject: v02i038: dungeon - game of adventure, Part05/14
- Message-ID: <1561@tekred.TEK.COM>
- Date: 1 Sep 87 20:19:28 GMT
- Sender: billr@tekred.TEK.COM
- Lines: 3050
- Approved: billr@tekred.TEK.COM
-
- Submitted by: Bill Randle <games-request@tekred.TEK.COM>
- Comp.sources.games: Volume 2, Issue 38
- Archive-name: dungeon/Part05
-
- #! /bin/sh
- # This is a shell archive. Remove anything before this line, then unpack
- # it by saving it into a file and typing "sh file". To overwrite existing
- # files, type "sh file -c". You can also feed this as standard input via
- # unshar, or by typing "sh <file", e.g.. If this archive is complete, you
- # will see the following message at the end:
- # "End of archive 5 (of 7)."
- # Contents: dinit.F dso2.F dsub.F dungeon.6 np3.F objects.h rtext.dat
- # Wrapped by billr@tekred on Tue Apr 21 10:24:31 1987
- PATH=/bin:/usr/bin:/usr/ucb ; export PATH
- if test -f dinit.F -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"dinit.F\"
- else
- echo shar: Extracting \"dinit.F\" \(10974 characters\)
- sed "s/^X//" >dinit.F <<'END_OF_dinit.F'
- X#include "files.h"
- X
- X#ifndef INDXFILE
- X#define INDXFILE '/usr/games/lib/dunlib/dindx.dat'
- X#endif
- X#ifndef TEXTFILE
- X#define TEXTFILE '/usr/games/lib/dunlib/dtext.dat'
- X#endif
- X#ifndef WIZARDID
- X#define WIZARDID 0
- X#endif
- X
- XC INIT-- DUNGEON INITIALIZATION SUBROUTINE
- XC
- XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
- XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
- XC WRITTEN BY R. M. SUPNIK
- XC
- XC DECLARATIONS
- XC
- X LOGICAL FUNCTION INIT(X)
- X IMPLICIT INTEGER (A-Z)
- X#ifndef PDP
- X LOGICAL PROTCT
- X INTEGER DATARRY(3)
- X#endif PDP
- X#include "parser.h"
- X#include "gamestate.h"
- X#include "state.h"
- X#include "screen.h"
- X#include "mindex.h"
- XC
- XC MISCELLANEOUS VARIABLES
- XC
- X COMMON /STAR/ MBASE,STRBIT
- X COMMON /VERS/ VMAJ,VMIN,VEDIT
- X COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
- X#include "io.h"
- X#include "debug.h"
- X COMMON /HYPER/ HFACTR
- X#include "rooms.h"
- X#include "rflag.h"
- X#include "rindex.h"
- X#include "exits.h"
- X#include "curxt.h"
- X#include "xpars.h"
- X#include "objects.h"
- X#include "oindex.h"
- X#include "clock.h"
- X#include "villians.h"
- X#include "advers.h"
- X#include "flags.h"
- XC INIT, PAGE 2
- XC
- X#ifndef PDP
- XC FIRST CHECK FOR PROTECTION VIOLATION
- XC
- X IF(PROTCT(X)) GO TO 10000
- XC !PROTECTION VIOLATION?
- X PRINT 10100
- X10100 FORMAT(' There appears before you a threatening figure clad '
- X& 'all over'/' in heavy black armor. His legs seem like the '
- X& 'massive trunk'/' of the oak tree. His broad shoulders and '
- X& 'helmeted head loom'/' high over your own puny frame, and '
- X& 'you realize that his powerful'/' arms could easily crush the '
- X& 'very life from your body. There'/' hangs from his belt a '
- X& 'veritable arsenal of deadly weapons:'/' sword, mace, ball '
- X& 'and chain, dagger, lance, and trident.'/' He speaks with a '
- X& 'commanding voice:'//20X,'"You shall not pass."'//' As '
- X& 'he grabs you by the neck all grows dim about you.')
- X CALL EXIT
- X#endif PDP
- XC
- XC NOW START INITIALIZATION PROPER
- XC
- X#ifdef PDP
- XC
- XC Note: arrays FLAGS & SWITCH are initialized in the following
- XC DATA statements, instead of using DO loops and assignments
- XC as used before. This saves some code space.
- XC
- X DATA FLAGS/.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
- X& .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
- X& .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
- X& .TRUE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.TRUE.,
- X& .FALSE.,.FALSE.,.FALSE.,.TRUE.,.FALSE.,.FALSE.,
- X& .FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,
- X& .FALSE.,.FALSE.,.FALSE.,.TRUE.,.TRUE.,.FALSE.,
- X& .TRUE.,.FALSE.,.FALSE.,.FALSE./
- XC
- X DATA SWITCH/0,0,0,0,0,0,0,0,0,
- X& 4,0,270,0,0,0,0,0,
- X& 1,1,0,0,10/
- XC
- XC Note: SWITCH(13) or MLOC is initialized equal to MRB later.
- XC
- XC
- X DATA LTSHFT/10/
- X DATA EGSCOR/0/
- X DATA EGMXSC/0/
- X DATA MXLOAD/100/
- X DATA RWSCOR/0/
- X DATA DEATHS/0/
- X DATA MOVES/0/
- X DATA PLTIME/0/
- X DATA MUNGRM/0/
- X DATA HS/0/
- X DATA PRSA/0/
- X DATA PRSI/0/
- X DATA PRSO/0/
- X DATA PRSCON/1/
- X DATA OFLAG/0/
- X DATA OACT/0/
- X DATA OSLOT/0/
- X DATA OPREP/0/
- X DATA ONAME/0/
- X DATA THFFLG/.FALSE./
- X DATA THFACT/.TRUE./
- X DATA SWDACT/.FALSE./
- X DATA SWDSTA/0/
- XC
- X DATA RECNO/1/
- X DATA MBASE/0/
- X DATA INPCH/5/
- X DATA OUTCH/5/
- X DATA DBCH/2/
- XC
- XC INIT, PAGE 3
- XC
- XC
- X DATA DBGFLG/0/
- X DATA PRSFLG/0/
- X DATA GDTFLG/0/
- XC
- X FROMDR=0
- X SCOLRM=0
- X SCOLAC=0
- X INIT=.FALSE.
- X MLOC=MRB
- XC
- XC INIT, PAGE 4
- XC
- XC NOW RESTORE FROM EXISTING INDEX FILE.
- XC
- X call intrd(i)
- X call intrd(j)
- X call intrd(k)
- X IF((I.NE.VMAJ).OR.(J.NE.VMIN))
- X& GO TO 1925
- XC
- X call intrd(MXSCOR)
- X call intrd(STRBIT)
- X call intrd(EGMXSC)
- XC
- X call intrd(RLNT)
- X call intrd(RDESC2)
- X call aryrd(200,RDESC1)
- X call aryrd(200,REXIT)
- X call aryrd(200,RACTIO)
- X call aryrd(200,RVAL)
- X call aryrd(200,RFLAG)
- XC
- X call intrd(XLNT)
- X call aryrd(900,TRAVEL)
- X call intrd(OLNT)
- X call aryrd(220,ODESC1)
- X call aryrd(220,ODESC2)
- X call aryrd(220,ODESCO)
- X call aryrd(220,OACTIO)
- X call aryrd(220,OFLAG1)
- X call aryrd(220,OFLAG2)
- X call aryrd(220,OFVAL)
- X call aryrd(220,OTVAL)
- X call aryrd(220,OSIZE)
- X call aryrd(220,OCAPAC)
- X call aryrd(220,OROOM)
- X call aryrd(220,OADV)
- X call aryrd(220,OCAN)
- X call aryrd(220,OREAD)
- XC
- X call intrd(R2LNT)
- X call aryrd(20,O2)
- X call aryrd(20,R2)
- XC
- X call intrd(CLNT)
- X call aryrd(25,CTICK)
- X call aryrd(25,CACTIO)
- XC
- X do 990 i=1,25
- X cflag(i)=.TRUE.
- X call logrd(j)
- X if(j.EQ.0) CFLAG(i)=.FALSE.
- X990 continue
- XC
- X call intrd(VLNT)
- X call aryrd(4,VILLNS)
- X call aryrd(4,VPROB)
- X call aryrd(4,VOPPS)
- X call aryrd(4,VBEST)
- X call aryrd(4,VMELEE)
- XC
- X call intrd(ALNT)
- X call aryrd(4,AROOM)
- X call aryrd(4,ASCORE)
- X call aryrd(4,AVEHIC)
- X call aryrd(4,AOBJ)
- X call aryrd(4,AACTIO)
- X call aryrd(4,ASTREN)
- X call aryrd(4,AFLAG)
- XC
- X call intrd(MBASE)
- X call intrd(MLNT)
- XC
- XC The RTEXT array is not used here, and isn't read (it's used
- XC in "speak.F")
- XC
- X call initnd
- XC
- XC INIT, PAGE 5
- XC
- XC THE INTERNAL DATA BASE IS NOW ESTABLISHED.
- XC SET UP TO PLAY THE GAME.
- XC
- X1025 CALL ITIME(SHOUR,SMIN,SSEC)
- X CALL INIRND(or(SHOUR,or(SMIN,SSEC)))
- XC
- X WINNER=PLAYER
- X LASTIT=AOBJ(PLAYER)
- X HERE=AROOM(WINNER)
- X THFPOS=OROOM(THIEF)
- X BLOC=OROOM(BALLO)
- X INIT=.TRUE.
- X#ifdef debug
- XC
- XC Normally, PRSFLG is setable in gdt to allow seeing various
- XC parse results. Since the pdp version does not have gdt,
- XC PRSFLG is set to show full debugging info when debug is enabled.
- XC
- X PRSFLG=65535
- X#endif debug
- XC
- XC
- X RETURN
- XC INIT, PAGE 6
- XC
- XC ERRORS-- INIT FAILS.
- XC
- X1925 continue
- X END
- X#else PDP
- X10000 INIT=.FALSE.
- XC !ASSUME INIT FAILS.
- X MMAX=1050
- XC !SET UP ARRAY LIMITS.
- X OMAX=220
- X RMAX=200
- X VMAX=4
- X AMAX=4
- X CMAX=25
- X FMAX=46
- X SMAX=22
- X XMAX=900
- X R2MAX=20
- X DIRMAX=15
- XC
- X MLNT=0
- XC !INIT ARRAY COUNTERS.
- X OLNT=0
- X RLNT=0
- X VLNT=0
- X ALNT=0
- X CLNT=0
- X XLNT=1
- X R2LNT=0
- XC
- X LTSHFT=10
- XC !SET UP STATE VARIABLES.
- X MXSCOR=LTSHFT
- X EGSCOR=0
- X EGMXSC=0
- X MXLOAD=100
- X RWSCOR=0
- X DEATHS=0
- X MOVES=0
- X PLTIME=0
- X MUNGRM=0
- X HS=0
- X PRSA=0
- XC !CLEAR PARSE VECTOR.
- X PRSI=0
- X PRSO=0
- X PRSCON=1
- X OFLAG=0
- XC !CLEAR ORPHANS.
- X OACT=0
- X OSLOT=0
- X OPREP=0
- X ONAME=0
- X THFFLG=.FALSE.
- XC !THIEF NOT INTRODUCED BUT
- X THFACT=.TRUE.
- XC !IS ACTIVE.
- X SWDACT=.FALSE.
- XC !SWORD IS INACTIVE.
- X SWDSTA=0
- XC !SWORD IS OFF.
- XC
- X RECNO=1
- XC !INIT DB FILE POINTER.
- X MBASE=0
- XC !INIT MELEE BASE.
- XC LOGICAL UNIT NRS: 5=STDIN, 6=STDOUT
- X INPCH=5
- XC !TTY INPUT
- X OUTCH=6
- X DBCH=2
- XC !DATA BASE.
- XC INIT, PAGE 3
- XC
- XC INIT ALL ARRAYS.
- XC
- X DO 5 I=1,CMAX
- XC !CLEAR CLOCK EVENTS
- X CFLAG(I)=.FALSE.
- X CTICK(I)=0
- X CACTIO(I)=0
- X5 CONTINUE
- XC
- X DO 10 I=1,FMAX
- XC !CLEAR FLAGS.
- X FLAGS(I)=.FALSE.
- X10 CONTINUE
- X BUOYF=.TRUE.
- XC !SOME START AS TRUE.
- X EGYPTF=.TRUE.
- X CAGETF=.TRUE.
- X MR1F=.TRUE.
- X MR2F=.TRUE.
- X FOLLWF=.TRUE.
- X DO 12 I=1,SMAX
- XC !CLEAR SWITCHES.
- X SWITCH(I)=0
- X12 CONTINUE
- X ORMTCH=4
- XC !NUMBER OF MATCHES.
- X LCELL=1
- X PNUMB=1
- X MDIR=270
- X MLOC=MRB
- X CPHERE=10
- XC
- X DO 15 I=1,R2MAX
- XC !CLEAR ROOM 2 ARRAY.
- X RROOM2(I)=0
- X OROOM2(I)=0
- X15 CONTINUE
- XC
- X DO 20 I=1,XMAX
- XC !CLEAR TRAVEL ARRAY.
- X TRAVEL(I)=0
- X20 CONTINUE
- XC
- X DO 30 I=1,VMAX
- XC !CLEAR VILLAINS ARRAYS.
- X VOPPS(I)=0
- X VPROB(I)=0
- X VILLNS(I)=0
- X VBEST(I)=0
- X VMELEE(I)=0
- X30 CONTINUE
- XC
- X DO 40 I=1,OMAX
- XC !CLEAR OBJECT ARRAYS.
- X ODESC1(I)=0
- X ODESC2(I)=0
- X ODESCO(I)=0
- X OREAD(I)=0
- X OACTIO(I)=0
- X OFLAG1(I)=0
- X OFLAG2(I)=0
- X OFVAL(I)=0
- X OTVAL(I)=0
- X OSIZE(I)=0
- X OCAPAC(I)=0
- X OCAN(I)=0
- X OADV(I)=0
- X OROOM(I)=0
- X40 CONTINUE
- XC
- X RDESC2=0
- XC !CLEAR DESC BASE PTR.
- X DO 50 I=1,RMAX
- XC !CLEAR ROOM ARRAYS.
- X RDESC1(I)=0
- X RACTIO(I)=0
- X RFLAG(I)=0
- X RVAL(I)=0
- X REXIT(I)=0
- X50 CONTINUE
- XC
- X DO 60 I=1,MMAX
- XC !CLEAR MESSAGE DIRECTORY.
- X RTEXT(I)=0
- X60 CONTINUE
- XC
- X DO 70 I=1,AMAX
- XC !CLEAR ADVENTURER'S ARRAYS.
- X AROOM(I)=0
- X ASCORE(I)=0
- X AVEHIC(I)=0
- X AOBJ(I)=0
- X AACTIO(I)=0
- X ASTREN(I)=0
- X AFLAG(I)=0
- X70 CONTINUE
- XC
- X DBGFLG=0
- X PRSFLG=0
- X GDTFLG=0
- XC
- XC allow setting gdtflg true if user id matches wizard id
- XC this way, the wizard doesn't have to recompile to use gdt
- XC
- X if (getuid() .eq. WIZARDID) gdtflg=1
- XC
- X FROMDR=0
- XC !INIT SCOL GOODIES.
- X SCOLRM=0
- X SCOLAC=0
- XC INIT, PAGE 4
- XC
- XC NOW RESTORE FROM EXISTING INDEX FILE.
- XC
- X OPEN(UNIT=1,file=INDXFILE,status='OLD',
- X& FORM='FORMATTED',ACCESS='SEQUENTIAL',ERR=1900)
- X READ(1,130) I,J,K
- XC !GET VERSION.
- X IF((I.NE.VMAJ).OR.(J.NE.VMIN))
- X& GO TO 1925
- X
- X OPEN(UNIT=DBCH,file=TEXTFILE,status='OLD',
- X& FORM='UNFORMATTED',ACCESS='DIRECT',
- X& recl=76,ERR=1950)
- X
- X#ifdef debug
- X PRINT 150
- X150 FORMAT(' RESTORING FROM "dindx.dat"')
- X#endif debug
- X READ(1,130) MXSCOR,STRBIT,EGMXSC
- X READ(1,130) RLNT,RDESC2,RDESC1,REXIT,RACTIO,RVAL,RFLAG
- X READ(1,130) XLNT,TRAVEL
- X READ(1,130) OLNT,ODESC1,ODESC2,ODESCO,OACTIO,OFLAG1,OFLAG2,
- X& OFVAL,OTVAL,OSIZE,OCAPAC,OROOM,OADV,OCAN,
- X& OREAD
- X READ(1,130) R2LNT,OROOM2,RROOM2
- X READ(1,130) CLNT,CTICK,CACTIO
- X READ(1,135) CFLAG
- X READ(1,130) VLNT,VILLNS,VPROB,VOPPS,VBEST,VMELEE
- X READ(1,130) ALNT,AROOM,ASCORE,AVEHIC,AOBJ,AACTIO,ASTREN,AFLAG
- X READ(1,130) MBASE,MLNT,RTEXT
- XC
- X CLOSE(1)
- X GO TO 1025
- XC !INIT DONE.
- XC
- XC 130 FORMAT(I8)
- X130 FORMAT(I6)
- X135 FORMAT(L4)
- XC INIT, PAGE 5
- XC
- XC THE INTERNAL DATA BASE IS NOW ESTABLISHED.
- XC SET UP TO PLAY THE GAME.
- XC
- X1025 CALL ITIME(SHOUR,SMIN,SSEC)
- XC !GET TIME AND DATE.
- XC CALL IDATE(I,J,K)
- X CALL IDATE(DATARRY(1))
- X CALL INIRND(or(DATARRY(1),or(DATARRY(2),DATARRY(3))),
- X& or(SHOUR,or(SMIN,SSEC)))
- XC
- X WINNER=PLAYER
- X LASTIT=AOBJ(PLAYER)
- X HERE=AROOM(WINNER)
- X THFPOS=OROOM(THIEF)
- X BLOC=OROOM(BALLO)
- X INIT=.TRUE.
- XC
- X#ifdef debug
- X PRINT 1050,RLNT,RMAX,XLNT,XMAX,OLNT,OMAX,MLNT,MMAX,
- X& VLNT,VMAX,ALNT,AMAX,CLNT,CMAX,R2LNT,R2MAX
- X1050 FORMAT(' USED:'/1X,I5,' OF',I5,' ROOMS'/
- X& 1X,I5,' OF',I5,' EXITS'/
- X& 1X,I5,' OF',I5,' OBJECTS'/
- X& 1X,I5,' OF',I5,' MESSAGES'/
- X& 1X,I5,' OF',I5,' VILLAINS'/
- X& 1X,I5,' OF',I5,' ADVENTURERS'/
- X& 1X,I5,' OF',I5,' CLOCK EVENTS'/
- X& 1X,I5,' OF',I5,' ROOM2 SLOTS')
- X PRINT 1150,MXSCOR,EGMXSC,RECNO,RDESC2,MBASE,STRBIT
- X1150 FORMAT(' MAX SCORE=',I5/' EG SCORE=',I5/
- X& ' MAX RECNO=',I5/' RDESC2 BASE=',I5/
- X& ' MELEE START=',I5/' STAR MASK=',I7)
- X PAUSE 1
- X#endif debug
- XC
- X RETURN
- XC INIT, PAGE 6
- XC
- XC ERRORS-- INIT FAILS.
- XC
- X1900 PRINT 910
- X PRINT 980
- X RETURN
- X1925 PRINT 920,I,J,K,VMAJ,VMIN,VEDIT
- X PRINT 980
- X RETURN
- X1950 PRINT 960
- X PRINT 980
- X RETURN
- X910 FORMAT(' I can''t open ',INDXFILE,'.')
- X920 FORMAT(' "dindx.dat" is version ',I1,'.',I1,A1,'.'/
- X& ' I require version ',I1,'.',I1,A1,'.')
- X960 FORMAT(' I can''t open ',TEXTFILE,'.')
- X980 FORMAT(' Suddenly a sinister, wraithlike figure appears before '
- X& 'you,'/' seeming to float in the air. In a low, sorrowful voice'
- X& ' he says,'/' "Alas, the very nature of the world has changed, '
- X& 'and the dungeon'/' cannot be found. All must now pass away."'
- X& ' Raising his oaken staff'/' in farewell, he fades into the '
- X& 'spreading darkness. In his place'/' appears a tastefully '
- X& 'lettered sign reading:'//23X,'INITIALIZATION FAILURE'//
- X& ' The darkness becomes all encompassing, and your vision fails.')
- XC
- X END
- XC PROTCT-- CHECK FOR USER VIOLATION
- XC
- XC THIS ROUTINE SHOULD BE MODIFIED IF YOU WISH TO ADD SYSTEM
- XC DEPENDANT PROTECTION AGAINST ABUSE.
- XC
- XC AT THE MOMENT, PLAY IS PERMITTED UNDER ALL CIRCUMSTANCES.
- XC
- X LOGICAL FUNCTION PROTCT(X)
- X IMPLICIT INTEGER(A-Z)
- XC
- X PROTCT=.TRUE.
- X RETURN
- X END
- X#endif PDP
- END_OF_dinit.F
- if test 10974 -ne `wc -c <dinit.F`; then
- echo shar: \"dinit.F\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- if test -f dso2.F -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"dso2.F\"
- else
- echo shar: Extracting \"dso2.F\" \(3263 characters\)
- sed "s/^X//" >dso2.F <<'END_OF_dso2.F'
- XC MOVETO- MOVE PLAYER TO NEW ROOM
- XC
- XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
- XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
- XC WRITTEN BY R. M. SUPNIK
- XC
- XC DECLARATIONS
- XC
- X LOGICAL FUNCTION MOVETO(NR,WHO)
- X IMPLICIT INTEGER (A-Z)
- X LOGICAL NLV,LHR,LNR
- X#include "gamestate.h"
- X#include "rooms.h"
- X#include "rflag.h"
- X#include "objects.h"
- X#include "oindex.h"
- X#include "advers.h"
- XC MOVETO, PAGE 2
- XC
- X MOVETO=.FALSE.
- XC !ASSUME FAILS.
- X LHR=and(RFLAG(HERE),RLAND).NE.0
- X LNR=and(RFLAG(NR),RLAND).NE.0
- X J=AVEHIC(WHO)
- XC !HIS VEHICLE
- XC
- X IF(J.NE.0) GO TO 100
- XC !IN VEHICLE?
- X IF(LNR) GO TO 500
- XC !NO, GOING TO LAND?
- X CALL RSPEAK(427)
- XC !CAN'T GO WITHOUT VEHICLE.
- X RETURN
- XC
- X100 BITS=0
- XC !ASSUME NOWHERE.
- X IF(J.EQ.RBOAT) BITS=RWATER
- XC !IN BOAT?
- X IF(J.EQ.BALLO) BITS=RAIR
- XC !IN BALLOON?
- X IF(J.EQ.BUCKE) BITS=RBUCK
- XC !IN BUCKET?
- X NLV=and(RFLAG(NR),BITS).EQ.0
- X IF((.NOT.LNR .AND.NLV) .OR.
- X& (LNR.AND.LHR.AND.NLV.AND.(BITS.NE.RLAND)))
- X& GO TO 800
- XC
- X500 MOVETO=.TRUE.
- XC !MOVE SHOULD SUCCEED.
- X IF(and(RFLAG(NR),RMUNG).EQ.0) GO TO 600
- X CALL RSPEAK(RRAND(NR))
- XC !YES, TELL HOW.
- X RETURN
- XC
- X600 IF(WHO.NE.PLAYER) CALL NEWSTA(AOBJ(WHO),0,NR,0,0)
- X IF(J.NE.0) CALL NEWSTA(J,0,NR,0,0)
- X HERE=NR
- X AROOM(WHO)=HERE
- X CALL SCRUPD(RVAL(NR))
- XC !SCORE ROOM
- X RVAL(NR)=0
- X RETURN
- XC
- X800 CALL RSPSUB(428,ODESC2(J))
- XC !WRONG VEHICLE.
- X RETURN
- X END
- XC SCORE-- PRINT OUT CURRENT SCORE
- XC
- XC DECLARATIONS
- XC
- X SUBROUTINE SCORE(FLG)
- X IMPLICIT INTEGER (A-Z)
- X LOGICAL FLG
- X INTEGER RANK(10),ERANK(5)
- X#include "gamestate.h"
- X#include "state.h"
- XC
- X COMMON /CHAN/ INPCH,OUTCH,DBCH
- X#include "advers.h"
- X#include "flags.h"
- XC
- XC FUNCTIONS AND DATA
- XC
- X DATA RANK/20,19,18,16,12,8,4,2,1,0/
- X DATA ERANK/20,15,10,5,0/
- XC SCORE, PAGE 2
- XC
- X AS=ASCORE(WINNER)
- XC
- X IF(ENDGMF) GO TO 60
- XC !ENDGAME?
- X#ifdef PDP
- X call pscore(AS,MXSCOR,MOVES)
- X#else
- X IF(FLG) WRITE(OUTCH,100)
- X IF(.NOT.FLG) WRITE(OUTCH,110)
- X IF(MOVES.NE.1) WRITE(OUTCH,120) AS,MXSCOR,MOVES
- X IF(MOVES.EQ.1) WRITE(OUTCH,130) AS,MXSCOR,MOVES
- X#endif PDP
- XC
- X DO 10 I=1,10
- X IF((AS*20/MXSCOR).GE.RANK(I)) GO TO 50
- X10 CONTINUE
- X50 CALL RSPEAK(484+I)
- X RETURN
- XC
- X#ifdef PDP
- X60 continue
- X call pscore(EGSCOR,EGMXSC,MOVES)
- X#else
- X60 IF(FLG) WRITE(OUTCH,140)
- X IF(.NOT.FLG) WRITE(OUTCH,150)
- X WRITE(OUTCH,120) EGSCOR,EGMXSC,MOVES
- X#endif PDP
- X DO 70 I=1,5
- X IF((EGSCOR*20/EGMXSC).GE.ERANK(I)) GO TO 80
- X70 CONTINUE
- X80 CALL RSPEAK(786+I)
- X RETURN
- X
- X#ifndef PDP
- X100 FORMAT(' Your score would be',$)
- X110 FORMAT(' Your score is',$)
- X120 FORMAT('+',I4,' [total of',I4,' points], in',I5,' moves.')
- X130 FORMAT('+',I4,' [total of',I4,' points], in',I5,' move.')
- X140 FORMAT(' Your score in the endgame would be',$)
- X150 FORMAT(' Your score in the endgame is',$)
- X#endif PDP
- XC
- X END
- XC SCRUPD- UPDATE WINNER'S SCORE
- XC
- XC DECLARATIONS
- XC
- X SUBROUTINE SCRUPD(N)
- X IMPLICIT INTEGER (A-Z)
- X#include "gamestate.h"
- X#include "state.h"
- X#include "clock.h"
- X#include "advers.h"
- X#include "flags.h"
- XC
- X IF(ENDGMF) GO TO 100
- XC !ENDGAME?
- X ASCORE(WINNER)=ASCORE(WINNER)+N
- XC !UPDATE SCORE
- X RWSCOR=RWSCOR+N
- XC !UPDATE RAW SCORE
- X IF(ASCORE(WINNER).LT.(MXSCOR-(10*DEATHS))) RETURN
- X CFLAG(CEVEGH)=.TRUE.
- XC !TURN ON END GAME
- X CTICK(CEVEGH)=15
- X RETURN
- XC
- X100 EGSCOR=EGSCOR+N
- XC !UPDATE EG SCORE.
- X RETURN
- X END
- END_OF_dso2.F
- if test 3263 -ne `wc -c <dso2.F`; then
- echo shar: \"dso2.F\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- if test -f dsub.F -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"dsub.F\"
- else
- echo shar: Extracting \"dsub.F\" \(10390 characters\)
- sed "s/^X//" >dsub.F <<'END_OF_dsub.F'
- XC RESIDENT SUBROUTINES FOR DUNGEON
- XC
- XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
- XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
- XC WRITTEN BY R. M. SUPNIK
- XC
- XC RSPEAK-- OUTPUT RANDOM MESSAGE ROUTINE
- XC
- XC CALLED BY--
- XC
- XC CALL RSPEAK(MSGNUM)
- XC
- X SUBROUTINE RSPEAK(N)
- X IMPLICIT INTEGER(A-Z)
- XC
- X CALL RSPSB2(N,0,0)
- X RETURN
- X END
- XC RSPSUB-- OUTPUT RANDOM MESSAGE WITH SUBSTITUTABLE ARGUMENT
- XC
- XC CALLED BY--
- XC
- XC CALL RSPSUB(MSGNUM,SUBNUM)
- XC
- X SUBROUTINE RSPSUB(N,S1)
- X IMPLICIT INTEGER(A-Z)
- XC
- X CALL RSPSB2(N,S1,0)
- X RETURN
- X END
- XC RSPSB2-- OUTPUT RANDOM MESSAGE WITH UP TO TWO SUBSTITUTABLE ARGUMENTS
- XC
- XC CALLED BY--
- XC
- XC CALL RSPSB2(MSGNUM,SUBNUM1,SUBNUM2)
- XC
- X SUBROUTINE RSPSB2(N,S1,S2)
- X IMPLICIT INTEGER(A-Z)
- X#ifndef PDP
- X CHARACTER*74 B1,B2,B3
- X INTEGER*2 OLDREC,NEWREC,JREC
- X#endif PDP
- XC
- XC DECLARATIONS
- XC
- X#include "gamestate.h"
- XC
- X#ifdef PDP
- X TELFLG=.TRUE.
- XC
- XC use C routine to access data base
- XC
- X call rspsb3(N,S1,S2)
- X return
- X#else
- X#include "mindex.h"
- X#include "io.h"
- XC
- XC CONVERT ALL ARGUMENTS FROM DICTIONARY NUMBERS (IF POSITIVE)
- XC TO ABSOLUTE RECORD NUMBERS.
- XC
- X X=N
- XC !SET UP WORK VARIABLES.
- X Y=S1
- X Z=S2
- X IF(X.GT.0) X=RTEXT(X)
- XC !IF >0, LOOK UP IN RTEXT.
- X IF(Y.GT.0) Y=RTEXT(Y)
- X IF(Z.GT.0) Z=RTEXT(Z)
- X X=IABS(X)
- XC !TAKE ABS VALUE.
- X Y=IABS(Y)
- X Z=IABS(Z)
- X IF(X.EQ.0) RETURN
- XC !ANYTHING TO DO?
- X TELFLG=.TRUE.
- XC !SAID SOMETHING.
- XC
- X READ(UNIT=DBCH,REC=X) OLDREC,B1
- XC
- X100 DO 150 I=1,74
- X X1=and(X,31)+I
- X B1(I:I)=char(xor(ichar(B1(I:I)),X1))
- X150 CONTINUE
- XC
- X200 IF(Y.EQ.0) GO TO 400
- XC !ANY SUBSTITUTABLE?
- X DO 300 I=1,74
- XC !YES, LOOK FOR #.
- X IF(B1(I:I).EQ.'#') GO TO 1000
- X300 CONTINUE
- XC
- X400 DO 500 I=74,1,-1
- XC !BACKSCAN FOR BLANKS.
- X IF(B1(I:I).NE.' ') GO TO 600
- X500 CONTINUE
- XC
- X600 WRITE(OUTCH,650) (B1(J:J),J=1,I)
- X650 FORMAT(1X,74A1)
- X X=X+1
- XC !ON TO NEXT RECORD.
- X READ(UNIT=DBCH,REC=X) NEWREC,B1
- X IF(OLDREC.EQ.NEWREC) GO TO 100
- XC !CONTINUATION?
- X RETURN
- XC !NO, EXIT.
- XC
- XC SUBSTITUTION WITH SUBSTITUTABLE AVAILABLE.
- XC I IS INDEX OF # IN B1.
- XC Y IS NUMBER OF RECORD TO SUBSTITUTE.
- XC
- XC PROCEDURE:
- XC 1) COPY REST OF B1 TO B2
- XC 2) READ SUBSTITUTABLE OVER B1
- XC 3) RESTORE TAIL OF ORIGINAL B1
- XC
- XC THE IMPLICIT ASSUMPTION HERE IS THAT THE SUBSTITUTABLE STRING
- XC IS VERY SHORT (i.e. MUCH LESS THAN ONE RECORD).
- XC
- X1000 K2=1
- XC !TO
- X DO 1100 K1=I+1,74
- XC !COPY REST OF B1.
- X B2(K2:K2)=B1(K1:K1)
- X K2=K2+1
- X1100 CONTINUE
- XC
- XC READ SUBSTITUTE STRING INTO B3, AND DECRYPT IT:
- XC
- X READ(UNIT=DBCH,REC=Y) JREC,B3
- X DO 1150 K1=1,74
- X X1=and(Y,31)+K1
- X B3(K1:K1)=char(xor(ICHAR(B3(K1:K1)),X1))
- X1150 CONTINUE
- XC
- XC FILL REMAINDER OF B1 WITH CHARACTERS FROM B3:
- XC
- X K2=1
- X DO 1180 K1=I,74
- X B1(K1:K1)=B3(K2:K2)
- X K2=K2+1
- X1180 CONTINUE
- XC
- XC FIND END OF SUBSTITUTE STRING IN B1:
- XC
- X DO 1200 J=74,1,-1
- XC !ELIM TRAILING BLANKS.
- X IF(B1(J:J).NE.' ') GO TO 1300
- X1200 CONTINUE
- XC
- XC PUT TAIL END OF B1 (NOW IN B2) BACK INTO B1 AFTER SUBSTITUTE STRING:
- XC
- X1300 K1=1
- XC !FROM
- X DO 1400 K2=J+1,74
- XC !COPY REST OF B1 BACK.
- X B1(K2:K2)=B2(K1:K1)
- X K1=K1+1
- X1400 CONTINUE
- XC
- X Y=Z
- XC !SET UP FOR NEXT
- X Z=0
- XC !SUBSTITUTION AND
- X GO TO 200
- XC !RECHECK LINE.
- X#endif PDP
- XC
- X END
- XC OBJACT-- APPLY OBJECTS FROM PARSE VECTOR
- XC
- XC DECLARATIONS
- XC
- X LOGICAL FUNCTION OBJACT(X)
- X IMPLICIT INTEGER (A-Z)
- X LOGICAL OAPPLI
- X#include "parser.h"
- X#include "objects.h"
- XC
- X OBJACT=.TRUE.
- XC !ASSUME WINS.
- X IF(PRSI.EQ.0) GO TO 100
- XC !IND OBJECT?
- X IF(OAPPLI(OACTIO(PRSI),0)) RETURN
- XC !YES, LET IT HANDLE.
- XC
- X100 IF(PRSO.EQ.0) GO TO 200
- XC !DIR OBJECT?
- X IF(OAPPLI(OACTIO(PRSO),0)) RETURN
- XC !YES, LET IT HANDLE.
- XC
- X200 OBJACT=.FALSE.
- XC !LOSES.
- X RETURN
- X END
- X#ifndef PDP
- XC BUG-- REPORT FATAL SYSTEM ERROR
- XC
- XC CALLED BY--
- XC
- XC CALL BUG(NO,PAR)
- XC
- X SUBROUTINE BUG(A,B)
- X IMPLICIT INTEGER(A-Z)
- X#include "debug.h"
- XC
- X PRINT 100,A,B
- X IF(DBGFLG.NE.0) RETURN
- X CALL EXIT
- XC
- X100 FORMAT(' PROGRAM ERROR ',I2,', PARAMETER=',I6)
- X END
- X#endif PDP
- XC NEWSTA-- SET NEW STATUS FOR OBJECT
- XC
- XC CALLED BY--
- XC
- XC CALL NEWSTA(OBJECT,STRING,NEWROOM,NEWCON,NEWADV)
- XC
- X SUBROUTINE NEWSTA(O,R,RM,CN,AD)
- X IMPLICIT INTEGER(A-Z)
- X#include "objects.h"
- XC
- X CALL RSPEAK(R)
- X OROOM(O)=RM
- X OCAN(O)=CN
- X OADV(O)=AD
- X RETURN
- X END
- XC QHERE-- TEST FOR OBJECT IN ROOM
- XC
- XC DECLARATIONS
- XC
- X LOGICAL FUNCTION QHERE(OBJ,RM)
- X IMPLICIT INTEGER (A-Z)
- X#include "objects.h"
- XC
- X QHERE=.TRUE.
- X IF(OROOM(OBJ).EQ.RM) RETURN
- XC !IN ROOM?
- X DO 100 I=1,R2LNT
- XC !NO, SCH ROOM2.
- X IF((OROOM2(I).EQ.OBJ).AND.(RROOM2(I).EQ.RM)) RETURN
- X100 CONTINUE
- X QHERE=.FALSE.
- XC !NOT PRESENT.
- X RETURN
- X END
- XC QEMPTY-- TEST FOR OBJECT EMPTY
- XC
- XC DECLARATIONS
- XC
- X LOGICAL FUNCTION QEMPTY(OBJ)
- X IMPLICIT INTEGER (A-Z)
- X#include "objects.h"
- XC
- X QEMPTY=.FALSE.
- XC !ASSUME LOSE.
- X DO 100 I=1,OLNT
- X IF(OCAN(I).EQ.OBJ) RETURN
- XC !INSIDE TARGET?
- X100 CONTINUE
- X QEMPTY=.TRUE.
- X RETURN
- X END
- XC JIGSUP- YOU ARE DEAD
- XC
- XC DECLARATIONS
- XC
- X SUBROUTINE JIGSUP(DESC)
- X IMPLICIT INTEGER (A-Z)
- X LOGICAL YESNO,MOVETO,QHERE,F
- X INTEGER RLIST(9)
- X#include "parser.h"
- X#include "gamestate.h"
- X#include "state.h"
- X#include "io.h"
- X#include "debug.h"
- X#include "rooms.h"
- X#include "rflag.h"
- X#include "rindex.h"
- X#include "objects.h"
- X#include "oflags.h"
- X#include "oindex.h"
- X#include "advers.h"
- X#include "flags.h"
- XC
- XC FUNCTIONS AND DATA
- XC
- X DATA RLIST/8,6,36,35,34,4,34,6,5/
- XC JIGSUP, PAGE 2
- XC
- X CALL RSPEAK(DESC)
- XC !DESCRIBE SAD STATE.
- X PRSCON=1
- XC !STOP PARSER.
- X IF(DBGFLG.NE.0) RETURN
- XC !IF DBG, EXIT.
- X AVEHIC(WINNER)=0
- XC !GET RID OF VEHICLE.
- X IF(WINNER.EQ.PLAYER) GO TO 100
- XC !HIMSELF?
- X CALL RSPSUB(432,ODESC2(AOBJ(WINNER)))
- XC !NO, SAY WHO DIED.
- X CALL NEWSTA(AOBJ(WINNER),0,0,0,0)
- XC !SEND TO HYPER SPACE.
- X RETURN
- XC
- X100 IF(ENDGMF) GO TO 900
- XC !NO RECOVERY IN END GAME.
- X IF(DEATHS.GE.2) GO TO 1000
- XC !DEAD TWICE? KICK HIM OFF.
- X IF(.NOT.YESNO(10,9,8)) GO TO 1100
- XC !CONTINUE?
- XC
- X DO 50 J=1,OLNT
- XC !TURN OFF FIGHTING.
- X IF(QHERE(J,HERE)) OFLAG2(J)=and(OFLAG2(J),not(FITEBT))
- X50 CONTINUE
- XC
- X DEATHS=DEATHS+1
- X CALL SCRUPD(-10)
- XC !CHARGE TEN POINTS.
- X F=MOVETO(FORE1,WINNER)
- XC !REPOSITION HIM.
- X EGYPTF=.TRUE.
- XC !RESTORE COFFIN.
- X IF(OADV(COFFI).EQ.WINNER) CALL NEWSTA(COFFI,0,EGYPT,0,0)
- X OFLAG2(DOOR)=and(OFLAG2(DOOR),not(TCHBT))
- X OFLAG1(ROBOT)=and(or(OFLAG1(ROBOT),VISIBT),not(NDSCBT))
- X IF((OROOM(LAMP).NE.0).OR.(OADV(LAMP).EQ.WINNER))
- X& CALL NEWSTA(LAMP,0,LROOM,0,0)
- XC
- XC NOW REDISTRIBUTE HIS VALUABLES AND OTHER BELONGINGS.
- XC
- XC THE LAMP HAS BEEN PLACED IN THE LIVING ROOM.
- XC THE FIRST 8 NON-VALUABLES ARE PLACED IN LOCATIONS AROUND THE HOUSE.
- XC HIS VALUABLES ARE PLACED AT THE END OF THE MAZE.
- XC REMAINING NON-VALUABLES ARE PLACED AT THE END OF THE MAZE.
- XC
- X I=1
- X DO 200 J=1,OLNT
- XC !LOOP THRU OBJECTS.
- X IF((OADV(J).NE.WINNER).OR.(OTVAL(J).NE.0))
- X& GO TO 200
- X I=I+1
- X IF(I.GT.9) GO TO 400
- XC !MOVE TO RANDOM LOCATIONS.
- X CALL NEWSTA(J,0,RLIST(I),0,0)
- X200 CONTINUE
- XC
- X400 I=RLNT+1
- XC !NOW MOVE VALUABLES.
- X NONOFL=RAIR+RWATER+RSACRD+REND
- XC !DONT MOVE HERE.
- X DO 300 J=1,OLNT
- X IF((OADV(J).NE.WINNER).OR.(OTVAL(J).EQ.0))
- X& GO TO 300
- X250 I=I-1
- XC !FIND NEXT ROOM.
- X IF(and(RFLAG(I),NONOFL).NE.0) GO TO 250
- X CALL NEWSTA(J,0,I,0,0)
- XC !YES, MOVE.
- X300 CONTINUE
- XC
- X DO 500 J=1,OLNT
- XC !NOW GET RID OF REMAINDER.
- X IF(OADV(J).NE.WINNER) GO TO 500
- X450 I=I-1
- XC !FIND NEXT ROOM.
- X IF(and(RFLAG(I),NONOFL).NE.0) GO TO 450
- X CALL NEWSTA(J,0,I,0,0)
- X500 CONTINUE
- X RETURN
- XC
- XC CAN'T OR WON'T CONTINUE, CLEAN UP AND EXIT.
- XC
- X900 CALL RSPEAK(625)
- XC !IN ENDGAME, LOSE.
- X GO TO 1100
- XC
- X1000 CALL RSPEAK(7)
- XC !INVOLUNTARY EXIT.
- X1100 CALL SCORE(.FALSE.)
- XC !TELL SCORE.
- X#ifdef PDP
- XC file closed in exit routine
- X#else
- X CLOSE(DBCH)
- X#endif PDP
- X CALL EXIT
- XC
- X END
- XC OACTOR- GET ACTOR ASSOCIATED WITH OBJECT
- XC
- XC DECLARATIONS
- XC
- X INTEGER FUNCTION OACTOR(OBJ)
- X IMPLICIT INTEGER(A-Z)
- X#include "advers.h"
- XC
- X DO 100 I=1,ALNT
- XC !LOOP THRU ACTORS.
- X OACTOR=I
- XC !ASSUME FOUND.
- X IF(AOBJ(I).EQ.OBJ) RETURN
- XC !FOUND IT?
- X100 CONTINUE
- X CALL BUG(40,OBJ)
- XC !NO, DIE.
- X RETURN
- X END
- XC PROB- COMPUTE PROBABILITY
- XC
- XC DECLARATIONS
- XC
- X LOGICAL FUNCTION PROB(G,B)
- X IMPLICIT INTEGER(A-Z)
- X#include "flags.h"
- XC
- X I=G
- XC !ASSUME GOOD LUCK.
- X IF(BADLKF) I=B
- XC !IF BAD, TOO BAD.
- X PROB=RND(100).LT.I
- XC !COMPUTE.
- X RETURN
- X END
- XC RMDESC-- PRINT ROOM DESCRIPTION
- XC
- XC RMDESC PRINTS A DESCRIPTION OF THE CURRENT ROOM.
- XC IT IS ALSO THE PROCESSOR FOR VERBS 'LOOK' AND 'EXAMINE'.
- XC
- X LOGICAL FUNCTION RMDESC(FULL)
- XC
- XC FULL= 0/1/2/3= SHORT/OBJ/ROOM/FULL
- XC
- XC DECLARATIONS
- XC
- X IMPLICIT INTEGER (A-Z)
- X LOGICAL PROB,LIT,RAPPLI
- X#include "parser.h"
- X#include "gamestate.h"
- X#include "screen.h"
- X#include "rooms.h"
- X#include "rflag.h"
- X#include "xsrch.h"
- X#include "objects.h"
- X#include "advers.h"
- X#include "verbs.h"
- X#include "flags.h"
- XC RMDESC, PAGE 2
- XC
- X RMDESC=.TRUE.
- XC !ASSUME WINS.
- X IF(PRSO.LT.XMIN) GO TO 50
- XC !IF DIRECTION,
- X FROMDR=PRSO
- XC !SAVE AND
- X PRSO=0
- XC !CLEAR.
- X50 IF(HERE.EQ.AROOM(PLAYER)) GO TO 100
- XC !PLAYER JUST MOVE?
- X CALL RSPEAK(2)
- XC !NO, JUST SAY DONE.
- X PRSA=WALKIW
- XC !SET UP WALK IN ACTION.
- X RETURN
- XC
- X100 IF(LIT(HERE)) GO TO 300
- XC !LIT?
- X CALL RSPEAK(430)
- XC !WARN OF GRUE.
- X RMDESC=.FALSE.
- X RETURN
- XC
- X300 RA=RACTIO(HERE)
- XC !GET ROOM ACTION.
- X IF(FULL.EQ.1) GO TO 600
- XC !OBJ ONLY?
- X I=RDESC2-HERE
- XC !ASSUME SHORT DESC.
- X IF((FULL.EQ.0)
- X& .AND.(SUPERF.OR.(((and(RFLAG(HERE),RSEEN)).NE.0)
- X& .AND.(BRIEFF.OR.PROB(80,80))))) GO TO 400
- X I=RDESC1(HERE)
- XC !USE LONG.
- X IF((I.NE.0).OR.(RA.EQ.0)) GO TO 400
- XC !IF GOT DESC, SKIP.
- X PRSA=LOOKW
- XC !PRETEND LOOK AROUND.
- X IF(.NOT.RAPPLI(RA)) GO TO 100
- XC !ROOM HANDLES, NEW DESC?
- X PRSA=FOOW
- XC !NOP PARSER.
- X GO TO 500
- XC
- X400 CALL RSPEAK(I)
- XC !OUTPUT DESCRIPTION.
- X500 IF(AVEHIC(WINNER).NE.0) CALL RSPSUB(431,ODESC2(AVEHIC(WINNER)))
- XC
- X600 IF(FULL.NE.2) CALL PRINCR(FULL.NE.0,HERE)
- X RFLAG(HERE)=or(RFLAG(HERE),RSEEN)
- X IF((FULL.NE.0).OR.(RA.EQ.0)) RETURN
- XC !ANYTHING MORE?
- X PRSA=WALKIW
- XC !GIVE HIM A SURPISE.
- X IF(.NOT.RAPPLI(RA)) GO TO 100
- XC !ROOM HANDLES, NEW DESC?
- X PRSA=FOOW
- X RETURN
- XC
- X END
- XC RAPPLI- ROUTING ROUTINE FOR ROOM APPLICABLES
- XC
- XC DECLARATIONS
- XC
- X LOGICAL FUNCTION RAPPLI(RI)
- X IMPLICIT INTEGER(A-Z)
- X LOGICAL RAPPL1,RAPPL2
- X DATA NEWRMS/38/
- XC
- X RAPPLI=.TRUE.
- XC !ASSUME WINS.
- X IF(RI.EQ.0) RETURN
- XC !IF ZERO, WIN.
- X IF(RI.LT.NEWRMS) RAPPLI=RAPPL1(RI)
- XC !IF OLD, PROCESSOR 1.
- X IF(RI.GE.NEWRMS) RAPPLI=RAPPL2(RI)
- XC !IF NEW, PROCESSOR 2.
- X RETURN
- X END
- END_OF_dsub.F
- if test 10390 -ne `wc -c <dsub.F`; then
- echo shar: \"dsub.F\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- if test -f dungeon.6 -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"dungeon.6\"
- else
- echo shar: Extracting \"dungeon.6\" \(8989 characters\)
- sed "s/^X//" >dungeon.6 <<'END_OF_dungeon.6'
- X.TH DUNGEON 6 "February 9, 1987"
- X.SH NAME
- Xdungeon\ -\ Adventures in the Dungeons of Doom
- X.SH SYNOPSIS
- X.B dungeon
- X.br
- X.B dungeon
- X[-r [savefile]]\ \ \ --\ pdp-11 version only
- X.SH DESCRIPTION
- XDungeon is a game of adventure, danger, and low cunning. In it
- Xyou will explore some of the most amazing territory ever seen by mortal
- Xman. Hardened adventurers have run screaming from the terrors contained
- Xwithin.
- X.LP
- XIn Dungeon, the intrepid explorer delves into the forgotten secrets
- Xof a lost labyrinth deep in the bowels of the earth, searching for
- Xvast treasures long hidden from prying eyes, treasures guarded by
- Xfearsome monsters and diabolical traps!
- X.LP
- XDungeon was created at the Programming Technology Division of the MIT
- XLaboratory for Computer Science by Tim Anderson, Marc Blank, Bruce
- XDaniels, and Dave Lebling. It was inspired by the Adventure game of
- XCrowther and Woods, and the Dungeons and Dragons game of Gygax
- Xand Arneson. The original version was written in MDL (alias MUDDLE).
- XThe current version was translated from MDL into FORTRAN IV by
- Xa somewhat paranoid DEC engineer who prefers to remain anonymous.
- X.LP
- XOn-line information may be obtained with the commands HELP and INFO.
- X.SH OPTIONS
- XIn the pdp-11 version, the
- X.B -r
- Xflag allows restarting a saved game. The default savefile is
- X.I dungeon.sav
- Xwhich may be overriden on the command line. In the Vax version,
- Xthe game is restored by using the
- X.B restore
- Xcommand.
- X.SH DETAILS
- XFollowing, is the summary produced by the
- X.B info
- Xcommand:
- X.RS
- X.LP
- XWelcome to Dungeon!
- X.PP
- XYou are near a large dungeon, which is reputed to contain vast
- Xquantities of treasure. Naturally, you wish to acquire some of it.
- XIn order to do so, you must of course remove it from the dungeon. To
- Xreceive full credit for it, you must deposit it safely in the trophy
- Xcase in the living room of the house.
- X.PP
- XIn addition to valuables, the dungeon contains various objects
- Xwhich may or may not be useful in your attempt to get rich. You may
- Xneed sources of light, since dungeons are often dark, and weapons,
- Xsince dungeons often have unfriendly things wandering about. Reading
- Xmaterial is scattered around the dungeon as well; some of it
- Xis rumored to be useful.
- X.PP
- XTo determine how successful you have been, a score is kept.
- XWhen you find a valuable object and pick it up, you receive a
- Xcertain number of points, which depends on the difficulty of finding
- Xthe object. You receive extra points for transporting the treasure
- Xsafely to the living room and placing it in the trophy case. In
- Xaddition, some particularly interesting rooms have a value associated
- Xwith visiting them. The only penalty is for getting yourself killed,
- Xwhich you may do only twice.
- X.PP
- XOf special note is a thief (always carrying a large bag) who
- Xlikes to wander around in the dungeon (he has never been seen by the
- Xlight of day). He likes to take things. Since he steals for pleasure
- Xrather than profit and is somewhat sadistic, he only takes things which
- Xyou have seen. Although he prefers valuables, sometimes in his haste
- Xhe may take something which is worthless. From time to time, he examines
- Xhis take and discards objects which he doesn't like. He may occasionally
- Xstop in a room you are visiting, but more often he just wanders
- Xthrough and rips you off (he is a skilled pickpocket).
- X.RE
- X.SH COMMANDS
- X.LP
- X.TP 15
- X.B brief
- Xsuppresses printing of long room descriptions
- Xfor rooms which have been visited.
- X.TP
- X.B superbrief
- Xsuppresses
- Xprinting of long room descriptions for all rooms.
- X.TP
- X.B verbose
- Xrestores long descriptions.
- X.TP
- X.B info
- Xprints information which might give some idea
- Xof what the game is about.
- X.TP
- X.B quit
- Xprints your score and asks whether you wish
- Xto continue playing.
- X.TP
- X.B save
- Xsaves the state of the game for later continuation.
- X.TP
- X.B restore
- Xrestores a saved game.
- X.TP
- X.B inventory
- Xlists the objects in your possession.
- X.TP
- X.B look
- Xprints a description of your surroundings.
- X.TP
- X.B score
- Xprints your current score and ranking.
- X.TP
- X.B time
- Xtells you how long you have been playing.
- X.TP
- X.B diagnose
- Xreports on your injuries, if any.
- X.LP
- XThe
- X.B inventory
- Xcommand may be abbreviated
- X.BR i ;
- Xthe
- X.B look
- Xcommand may be abbreviated
- X.BR l ;
- Xthe
- X.B quit
- Xcommand may be abbreviated
- X.BR q .
- X.LP
- XA command that begins with '!' as the first character is taken to
- Xbe a shell command and is passed unchanged to the shell via
- X.I system(3).
- X.SH CONTAINMENT
- X.LP
- XSome objects can contain other objects. Many such containers can
- Xbe opened and closed. The rest are always open. They may or may
- Xnot be transparent. For you to access (e.g., take) an object
- Xwhich is in a container, the container must be open. For you
- Xto see such an object, the container must be either open or
- Xtransparent. Containers have a capacity, and objects have sizes;
- Xthe number of objects which will fit therefore depends on their
- Xsizes. You may put any object you have access to (it need not be
- Xin your hands) into any other object. At some point, the program
- Xwill attempt to pick it up if you don't already have it, which
- Xprocess may fail if you're carrying too much. Although containers
- Xcan contain other containers, the program doesn't access more than
- Xone level down.
- X.SH FIGHTING
- X.LP
- XOccupants of the dungeon will, as a rule, fight back when
- Xattacked. In some cases, they may attack even if unprovoked.
- XUseful verbs here are
- X.I attack
- X<villain>
- X.I with
- X<weapon>,
- X.IR kill ,
- Xetc. Knife-throwing may or may not be useful. You have a
- Xfighting strength which varies with time. Being in a fight,
- Xgetting killed, and being injured all lower this strength.
- XStrength is regained with time. Thus, it is not a good idea to
- Xfight someone immediately after being killed. Other details
- Xshould become apparent after a few melees or deaths.
- X.SH COMMAND\ PARSER
- X.LP
- XA command is one line of text terminated by a carriage return.
- XFor reasons of simplicity, all words are distinguished by their
- Xfirst six letters. All others are ignored. For example, typing
- X.I disassemble the encyclopedia
- Xis not only meaningless, it also
- Xcreates excess effort for your fingers. Note that this truncation
- Xmay produce ambiguities in the intepretation of longer words.
- X[Also note that upper and lower case are equivalent.]
- X.LP
- XYou are dealing with a fairly stupid parser, which understands
- Xthe following types of things:
- X.RS
- X.TP 5
- X.B Actions:
- XAmong the more obvious of these, such as
- X.I take, put, drop,
- Xetc.
- XFairly general forms of these may be used, such as
- X.I pick up, put down,
- Xetc.
- X.TP
- X.B Directions:
- X.I north, south, up, down,
- Xetc. and their various abbreviations.
- XOther more obscure directions
- X.RI ( land,
- X.IR cross )
- Xare appropriate in only certain situations.
- X.TP
- X.B Objects:
- XMost objects have names and can be referenced by them.
- X.TP
- X.B Adjectives:
- XSome adjectives are understood and required when there are
- Xtwo objects which can be referenced with the same 'name' (e.g.,
- X.I doors,
- X.IR buttons ).
- X.TP
- X.B Prepositions:
- XIt may be necessary in some cases to include prepositions, but
- Xthe parser attempts to handle cases which aren't ambiguous
- Xwithout. Thus
- X.I give car to demon
- Xwill work, as will
- X.I give demon
- X.IR car .
- X.I give car demon
- Xprobably won't do anything interesting.
- XWhen a preposition is used, it should be appropriate;
- X.I give car with demon
- Xwon't parse.
- X.TP
- X.B Sentences:
- XThe parser understands a reasonable number of syntactic construc-
- Xtions. In particular, multiple commands (separated by commas)
- Xcan be placed on the same line.
- X.TP
- X.B Ambiguity:
- XThe parser tries to be clever about what to do in the case of
- Xactions which require objects that are not explicitly specified.
- XIf there is only one possible object, the parser will assume
- Xthat it should be used. Otherwise, the parser will ask.
- XMost questions asked by the parser can be answered.
- X.RE
- X.SH FILES
- Xdindx.dat - game initialization info
- X.br
- Xdtext.dat - encoded messages
- X.br
- Xrindx.dat - index into message file for pdp version
- X.br
- Xdungeon.sav - default save file for pdp version
- X.br
- Xdsave.dat - default save file for non-pdp versions
- X.br
- Xlisten, speak - co-process routines for pdp version
- X.SH BUGS
- XFor those familiar with the MDL version of the game on the ARPAnet,
- Xthe following is a list of the major incompatabilties:
- X.RS
- X-The first six letters of a word are considered
- Xsignificant, instead of the first five.
- X.br
- X-The syntax for
- X.I tell, answer,
- Xand
- X.I incant
- Xis different.
- X.br
- X-Compound objects are not recognized.
- X.br
- X-Compound commands can be delimited with comma as well
- Xas period.
- X.RE
- X.LP
- XAlso, the palantir, brochure, and dead man problems are not
- Ximplemented.
- X.LP
- XThe pdp version is slightly stripped down to fit within the memory
- Xcontraints.
- XAn overlayed pdp version might be made that would allow the
- Xcomplete game to be compiled and loaded, but I don't have the
- Xinclination (or machine) to do it.
- X.SH AUTHORS
- X.LP
- XMany people have had a hand in this version. See the "History" and
- X"README" files for credits. Send bug reports to billr@tekred.TEK.COM
- X(or ...!tektronix!tekred!billr).
- END_OF_dungeon.6
- if test 8989 -ne `wc -c <dungeon.6`; then
- echo shar: \"dungeon.6\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- if test -f np3.F -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"np3.F\"
- else
- echo shar: Extracting \"np3.F\" \(7518 characters\)
- sed "s/^X//" >np3.F <<'END_OF_np3.F'
- XC SYNMCH-- SYNTAX MATCHER
- XC
- XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
- XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
- XC WRITTEN BY R. M. SUPNIK
- XC
- XC DECLARATIONS
- XC
- XC THIS ROUTINE DETAILS ON BIT 4 OF PRSFLG
- XC
- X LOGICAL FUNCTION SYNMCH()
- X IMPLICIT INTEGER(A-Z)
- X LOGICAL SYNEQL,TAKEIT
- X#include "parser.h"
- X#include "vocab.h"
- X#include "debug.h"
- XC
- XC THE FOLLOWING DATA STATEMENT WAS ORIGINALLY:
- XC
- XC DATA R50MIN/1RA/
- XC
- X DATA R50MIN/1600/
- XC
- X SYNMCH=.FALSE.
- X#ifdef debug
- X DFLAG=and(PRSFLG, 16).NE.0
- X write(0,*) "synflags=",sdir,sind,sstd,sflip,sdriv,svmask
- X#endif
- X J=ACT
- XC !SET UP PTR TO SYNTAX.
- X DRIVE=0
- XC !NO DEFAULT.
- X DFORCE=0
- XC !NO FORCED DEFAULT.
- X QPREP=and(OFLAG,OPREP)
- X100 J=J+2
- XC !FIND START OF SYNTAX.
- X IF((VVOC(J).LE.0).OR.(VVOC(J).GE.R50MIN)) GO TO 100
- X LIMIT=J+VVOC(J)+1
- XC !COMPUTE LIMIT.
- X J=J+1
- XC !ADVANCE TO NEXT.
- XC
- X200 CALL UNPACK(J,NEWJ)
- XC !UNPACK SYNTAX.
- X#ifdef debug
- X IF(DFLAG) PRINT 60,O1,P1,DOBJ,DFL1,DFL2
- X60 FORMAT(' SYNMCH INPUTS TO SYNEQL- ',5I7)
- X#endif
- X SPREP=and(DOBJ,VPMASK)
- X IF(.NOT.SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 1000
- X#ifdef debug
- X IF(DFLAG) PRINT 60,O2,P2,IOBJ,IFL1,IFL2
- X#endif
- X SPREP=and(IOBJ,VPMASK)
- X IF(SYNEQL(P2,O2,IOBJ,IFL1,IFL2)) GO TO 6000
- XC
- XC SYNTAX MATCH FAILS, TRY NEXT ONE.
- XC
- X IF(O2) 3000,500,3000
- XC !IF O2=0, SET DFLT.
- X1000 IF(O1) 3000,500,3000
- XC !IF O1=0, SET DFLT.
- X500 IF((QPREP.EQ.0).OR.(QPREP.EQ.SPREP)) DFORCE=J
- XC !IF PREP MCH.
- X IF((and(VFLAG,SDRIV)).NE.0) DRIVE=J
- X3000 J=NEWJ
- X IF(J.LT.LIMIT) GO TO 200
- XC !MORE TO DO?
- XC SYNMCH, PAGE 2
- XC
- XC MATCH HAS FAILED. IF DEFAULT SYNTAX EXISTS, TRY TO SNARF
- XC ORPHANS OR GWIMS, OR MAKE NEW ORPHANS.
- XC
- X#ifdef debug
- X IF(DFLAG) PRINT 20,DRIVE,DFORCE
- X20 FORMAT(' SYNMCH, DRIVE=',2I6)
- X#endif
- X IF(DRIVE.EQ.0) DRIVE=DFORCE
- XC !NO DRIVER? USE FORCE.
- X IF(DRIVE.EQ.0) GO TO 10000
- XC !ANY DRIVER?
- X CALL UNPACK(DRIVE,DFORCE)
- XC !UNPACK DFLT SYNTAX.
- XC
- XC TRY TO FILL DIRECT OBJECT SLOT IF THAT WAS THE PROBLEM.
- XC
- X IF((and(VFLAG,SDIR).EQ.0).OR.(O1.NE.0)) GO TO 4000
- XC
- XC FIRST TRY TO SNARF ORPHAN OBJECT.
- XC
- X O1=and(OFLAG,OSLOT)
- X IF(O1.EQ.0) GO TO 3500
- XC !ANY ORPHAN?
- X IF(SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 4000
- XC
- XC ORPHAN FAILS, TRY GWIM.
- XC
- X3500 O1=GWIM(DOBJ,DFW1,DFW2)
- XC !GET GWIM.
- X#ifdef debug
- X IF(DFLAG) PRINT 30,O1
- X30 FORMAT(' SYNMCH- DO GWIM= ',I6)
- X#endif debug
- X IF(O1.GT.0) GO TO 4000
- XC !TEST RESULT.
- X CALL ORPHAN(-1,ACT,0,and(DOBJ,VPMASK),0)
- X CALL RSPEAK(623)
- X RETURN
- XC
- XC TRY TO FILL INDIRECT OBJECT SLOT IF THAT WAS THE PROBLEM.
- XC
- X4000 IF((and(VFLAG,SIND).EQ.0).OR.(O2.NE.0)) GO TO 6000
- X O2=GWIM(IOBJ,IFW1,IFW2)
- XC !GWIM.
- X#ifdef debug
- X IF(DFLAG) PRINT 40,O2
- X40 FORMAT(' SYNMCH- IO GWIM= ',I6)
- X#endif debug
- X IF(O2.GT.0) GO TO 6000
- X IF(O1.EQ.0) O1=and(OFLAG,OSLOT)
- X CALL ORPHAN(-1,ACT,O1,and(DOBJ,VPMASK),0)
- X CALL RSPEAK(624)
- X RETURN
- XC
- XC TOTAL CHOMP
- XC
- X10000 CALL RSPEAK(601)
- XC !CANT DO ANYTHING.
- X RETURN
- XC SYNMCH, PAGE 3
- XC
- XC NOW TRY TO TAKE INDIVIDUAL OBJECTS AND
- XC IN GENERAL CLEAN UP THE PARSE VECTOR.
- XC
- X6000 IF(and(VFLAG,SFLIP).EQ.0) GO TO 5000
- X J=O1
- XC !YES.
- X O1=O2
- X O2=J
- XC
- X5000 PRSA=and(VFLAG,SVMASK)
- X PRSO=O1
- XC !GET DIR OBJ.
- X PRSI=O2
- XC !GET IND OBJ.
- X IF(.NOT.TAKEIT(PRSO,DOBJ)) RETURN
- XC !TRY TAKE.
- X IF(.NOT.TAKEIT(PRSI,IOBJ)) RETURN
- XC !TRY TAKE.
- X SYNMCH=.TRUE.
- X#ifdef debug
- X IF(DFLAG) PRINT 50,SYNMCH,PRSA,PRSO,PRSI,ACT,O1,O2
- X50 FORMAT(' SYNMCH- RESULTS ',L1,6I7)
- X#endif
- X RETURN
- XC
- X END
- XC UNPACK- UNPACK SYNTAX SPECIFICATION, ADV POINTER
- XC
- XC DECLARATIONS
- XC
- X SUBROUTINE UNPACK(OLDJ,J)
- X IMPLICIT INTEGER(A-Z)
- X#include "vocab.h"
- X#include "parser.h"
- XC
- X DO 10 I=1,11
- XC !CLEAR SYNTAX.
- X SYN(I)=0
- X10 CONTINUE
- XC
- X VFLAG=VVOC(OLDJ)
- X J=OLDJ+1
- X IF(and(VFLAG,SDIR).EQ.0) RETURN
- X DFL1=-1
- XC !ASSUME STD.
- X DFL2=-1
- X IF(and(VFLAG,SSTD).EQ.0) GO TO 100
- X DFW1=-1
- XC !YES.
- X DFW2=-1
- X DOBJ=VABIT+VRBIT+VFBIT
- X GO TO 200
- XC
- X100 DOBJ=VVOC(J)
- XC !NOT STD.
- X DFW1=VVOC(J+1)
- X DFW2=VVOC(J+2)
- X J=J+3
- X IF(and(DOBJ,VEBIT).EQ.0) GO TO 200
- X DFL1=DFW1
- XC !YES.
- X DFL2=DFW2
- XC
- X200 IF(and(VFLAG,SIND).EQ.0) RETURN
- X IFL1=-1
- XC !ASSUME STD.
- X IFL2=-1
- X IOBJ=VVOC(J)
- X IFW1=VVOC(J+1)
- X IFW2=VVOC(J+2)
- X J=J+3
- X IF(and(IOBJ,VEBIT).EQ.0) RETURN
- X IFL1=IFW1
- XC !YES.
- X IFL2=IFW2
- X RETURN
- XC
- X END
- XC SYNEQL- TEST FOR SYNTAX EQUALITY
- XC
- XC DECLARATIONS
- XC
- X LOGICAL FUNCTION SYNEQL(PREP,OBJ,SPREP,SFL1,SFL2)
- X IMPLICIT INTEGER(A-Z)
- X#include "objects.h"
- X#include "parser.h"
- XC
- X IF(OBJ.EQ.0) GO TO 100
- XC !ANY OBJECT?
- X SYNEQL=(PREP.EQ.and(SPREP,VPMASK)).AND.
- X& (or(and(SFL1,OFLAG1(OBJ)),
- X& and(SFL2,OFLAG2(OBJ))).NE.0)
- X RETURN
- XC
- X100 SYNEQL=(PREP.EQ.0).AND.(SFL1.EQ.0).AND.(SFL2.EQ.0)
- X RETURN
- XC
- X END
- XC TAKEIT- PARSER BASED TAKE OF OBJECT
- XC
- XC DECLARATIONS
- XC
- X LOGICAL FUNCTION TAKEIT(OBJ,SFLAG)
- X IMPLICIT INTEGER(A-Z)
- X#include "parser.h"
- X COMMON /STAR/ MBASE,STRBIT
- X#include "gamestate.h"
- X#include "state.h"
- X#include "objects.h"
- X#include "oflags.h"
- X#include "advers.h"
- XC TAKEIT, PAGE 2
- XC
- X TAKEIT=.FALSE.
- XC !ASSUME LOSES.
- X IF((OBJ.EQ.0).OR.(OBJ.GT.STRBIT)) GO TO 4000
- XC !NULL/STARS WIN.
- X ODO2=ODESC2(OBJ)
- XC !GET DESC.
- X X=OCAN(OBJ)
- XC !GET CONTAINER.
- X IF((X.EQ.0).OR.(and(SFLAG,VFBIT).EQ.0)) GO TO 500
- X IF(and(OFLAG2(X),OPENBT).NE.0) GO TO 500
- X CALL RSPSUB(566,ODO2)
- XC !CANT REACH.
- X RETURN
- XC
- X500 IF(and(SFLAG,VRBIT).EQ.0) GO TO 1000
- X IF(and(SFLAG,VTBIT).EQ.0) GO TO 2000
- XC
- XC SHOULD BE IN ROOM (VRBIT NE 0) AND CAN BE TAKEN (VTBIT NE 0)
- XC
- X IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000
- XC !IF NOT, OK.
- XC
- XC ITS IN THE ROOM AND CAN BE TAKEN.
- XC
- X IF((and(OFLAG1(OBJ),TAKEBT).NE.0).AND.
- X& (and(OFLAG2(OBJ),TRYBT).EQ.0)) GO TO 3000
- XC
- XC NOT TAKEABLE. IF WE CARE, FAIL.
- XC
- X IF(and(SFLAG,VCBIT).EQ.0) GO TO 4000
- X CALL RSPSUB(445,ODO2)
- X RETURN
- XC
- XC 1000-- IT SHOULD NOT BE IN THE ROOM.
- XC 2000-- IT CANT BE TAKEN.
- XC
- X2000 IF(and(SFLAG,VCBIT).EQ.0) GO TO 4000
- X1000 IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000
- X CALL RSPSUB(665,ODO2)
- X RETURN
- XC TAKEIT, PAGE 3
- XC
- XC OBJECT IS IN THE ROOM, CAN BE TAKEN BY THE PARSER,
- XC AND IS TAKEABLE IN GENERAL. IT IS NOT A STAR.
- XC TAKING IT SHOULD NOT HAVE SIDE AFFECTS.
- XC IF IT IS INSIDE SOMETHING, THE CONTAINER IS OPEN.
- XC THE FOLLOWING CODE IS LIFTED FROM SUBROUTINE TAKE.
- XC
- X3000 IF(OBJ.NE.AVEHIC(WINNER)) GO TO 3500
- XC !TAKE VEHICLE?
- X CALL RSPEAK(672)
- X RETURN
- XC
- X3500 IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR.
- X& ((WEIGHT(0,OBJ,WINNER)+OSIZE(OBJ)).LE.MXLOAD))
- X& GO TO 3700
- X CALL RSPEAK(558)
- XC !TOO BIG.
- X RETURN
- XC
- X3700 CALL NEWSTA(OBJ,559,0,0,WINNER)
- XC !DO TAKE.
- X OFLAG2(OBJ)=or(OFLAG2(OBJ),TCHBT)
- X CALL SCRUPD(OFVAL(OBJ))
- X OFVAL(OBJ)=0
- XC
- X4000 TAKEIT=.TRUE.
- XC !SUCCESS.
- X RETURN
- XC
- X END
- XC
- XC GWIM- GET WHAT I MEAN IN AMBIGOUS SITUATIONS
- XC
- XC DECLARATIONS
- XC
- X INTEGER FUNCTION GWIM(SFLAG,SFW1,SFW2)
- X IMPLICIT INTEGER(A-Z)
- X LOGICAL TAKEIT,NOCARE
- X#include "parser.h"
- X COMMON /STAR/ MBASE,STRBIT
- X#include "gamestate.h"
- X#include "objects.h"
- X#include "oflags.h"
- X#include "advers.h"
- XC GWIM, PAGE 2
- XC
- X GWIM=-1
- XC !ASSUME LOSE.
- X AV=AVEHIC(WINNER)
- X NOBJ=0
- X NOCARE=and(SFLAG,VCBIT).EQ.0
- XC
- XC FIRST SEARCH ADVENTURER
- XC
- X IF(and(SFLAG,VABIT).NE.0)
- X& NOBJ=FWIM(SFW1,SFW2,0,0,WINNER,NOCARE)
- X IF(and(SFLAG,VRBIT).NE.0) GO TO 100
- X50 GWIM=NOBJ
- X RETURN
- XC
- XC ALSO SEARCH ROOM
- XC
- X100 ROBJ=FWIM(SFW1,SFW2,HERE,0,0,NOCARE)
- X IF(ROBJ) 500,50,200
- XC !TEST RESULT.
- XC
- XC ROBJ > 0
- XC
- X200 IF((AV.EQ.0).OR.(ROBJ.EQ.AV).OR.
- X& (and(OFLAG2(ROBJ),FINDBT).NE.0)) GO TO 300
- X IF(OCAN(ROBJ).NE.AV) GO TO 50
- XC !UNREACHABLE? TRY NOBJ
- X300 IF(NOBJ.NE.0) RETURN
- XC !IF AMBIGUOUS, RETURN.
- X IF(.NOT.TAKEIT(ROBJ,SFLAG)) RETURN
- XC !IF UNTAKEABLE, RETURN
- X GWIM=ROBJ
- X500 RETURN
- XC
- X END
- END_OF_np3.F
- if test 7518 -ne `wc -c <np3.F`; then
- echo shar: \"np3.F\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- if test -f objects.h -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"objects.h\"
- else
- echo shar: Extracting \"objects.h\" \(302 characters\)
- sed "s/^X//" >objects.h <<'END_OF_objects.h'
- XC
- XC OBJECTS
- XC
- X COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
- X& OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
- X& OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
- X& OADV(220),OCAN(220),OREAD(220)
- X INTEGER EQO(220,14)
- X EQUIVALENCE (ODESC1, EQO)
- XC
- X COMMON /OROOM2/ R2LNT,OROOM2(20),RROOM2(20)
- END_OF_objects.h
- if test 302 -ne `wc -c <objects.h`; then
- echo shar: \"objects.h\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- if test -f rtext.dat -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"rtext.dat\"
- else
- echo shar: Extracting \"rtext.dat\" \(9450 characters\)
- sed "s/^X//" >rtext.dat <<'END_OF_rtext.dat'
- X -1
- X -2
- X -3
- X -14
- X -115
- X -148
- X -149
- X -153
- X -155
- X -158
- X -159
- X -161
- X -162
- X -163
- X -167
- X -170
- X -173
- X -174
- X -175
- X -176
- X -177
- X -180
- X -181
- X -183
- X -184
- X -185
- X -186
- X -188
- X -189
- X -190
- X -191
- X -192
- X -195
- X -197
- X -200
- X -202
- X -203
- X -206
- X -207
- X -209
- X -210
- X -211
- X -214
- X -216
- X -217
- X -224
- X -225
- X -226
- X -227
- X -229
- X -231
- X -234
- X -236
- X -237
- X -242
- X -244
- X -245
- X -246
- X -249
- X -256
- X -258
- X -261
- X -262
- X -265
- X -271
- X -273
- X -276
- X -279
- X -282
- X -284
- X -285
- X -286
- X -287
- X -288
- X -289
- X -290
- X -291
- X -292
- X -293
- X -294
- X -295
- X -296
- X -298
- X -300
- X -301
- X -303
- X -304
- X -305
- X -306
- X -307
- X -308
- X -309
- X -310
- X -311
- X -312
- X -313
- X -316
- X -317
- X -318
- X -322
- X -325
- X -326
- X -327
- X -328
- X -330
- X -333
- X -334
- X -336
- X -337
- X -338
- X -339
- X -340
- X -341
- X -344
- X -345
- X -348
- X -350
- X -352
- X -356
- X -363
- X -369
- X -370
- X -372
- X -373
- X -374
- X -375
- X -376
- X -377
- X -379
- X -380
- X -381
- X -382
- X -383
- X -384
- X -385
- X -386
- X -387
- X -388
- X -389
- X -390
- X -391
- X -392
- X -393
- X -395
- X -396
- X -398
- X -400
- X -401
- X -402
- X -404
- X -406
- X -407
- X -408
- X -409
- X -410
- X -411
- X -412
- X -413
- X -414
- X -416
- X -418
- X -422
- X -426
- X -427
- X -428
- X -429
- X -430
- X -432
- X -433
- X -437
- X -439
- X -440
- X -441
- X -442
- X -443
- X -444
- X -445
- X -446
- X -447
- X -448
- X -449
- X -450
- X -452
- X -453
- X -454
- X -455
- X -456
- X -457
- X -459
- X -462
- X -464
- X -466
- X -467
- X -468
- X -469
- X -470
- X -471
- X -473
- X -474
- X -475
- X -477
- X -478
- X -479
- X -480
- X -482
- X -484
- X -485
- X -486
- X -487
- X -488
- X -489
- X -490
- X -491
- X -492
- X -493
- X -494
- X -495
- X -496
- X -498
- X -499
- X -500
- X -501
- X -502
- X -503
- X -504
- X -505
- X -508
- X -509
- X -510
- X -512
- X -513
- X -514
- X -515
- X -518
- X -519
- X -520
- X -521
- X -522
- X -523
- X -524
- X -525
- X -526
- X -527
- X -528
- X -529
- X -530
- X -532
- X -535
- X -536
- X -537
- X -538
- X -539
- X -540
- X -541
- X -542
- X -543
- X -544
- X -549
- X -551
- X -552
- X -555
- X -558
- X -560
- X -563
- X -567
- X -568
- X -569
- X -570
- X -571
- X -572
- X -573
- X -574
- X -576
- X -577
- X -579
- X -580
- X -581
- X -582
- X -583
- X -584
- X -585
- X -588
- X -589
- X -590
- X -593
- X -595
- X -596
- X -597
- X -602
- X -604
- X -605
- X -606
- X -608
- X -609
- X -612
- X -614
- X -615
- X -616
- X -617
- X -618
- X -619
- X -620
- X -622
- X -623
- X -625
- X -626
- X -627
- X -628
- X -629
- X -630
- X -631
- X -632
- X -633
- X -634
- X -635
- X -636
- X -637
- X -638
- X -639
- X -640
- X -641
- X -642
- X -643
- X -644
- X -645
- X -646
- X -647
- X -648
- X -649
- X -650
- X -651
- X -652
- X -653
- X -654
- X -655
- X -658
- X -659
- X -661
- X -662
- X -663
- X -664
- X -665
- X -666
- X -667
- X -668
- X -669
- X -670
- X -671
- X -672
- X -673
- X -674
- X -675
- X -676
- X -677
- X -678
- X -679
- X -680
- X -681
- X -682
- X -683
- X -684
- X -685
- X -686
- X -688
- X -689
- X -692
- X -693
- X -694
- X -695
- X -696
- X -697
- X -698
- X -699
- X -700
- X -701
- X -702
- X -703
- X -704
- X -705
- X -706
- X -707
- X -708
- X -709
- X -710
- X -711
- X -712
- X -713
- X -714
- X -715
- X -716
- X -717
- X -718
- X -719
- X -720
- X -721
- X -722
- X -723
- X -724
- X -725
- X -726
- X -727
- X -728
- X -729
- X -730
- X -731
- X -732
- X -733
- X -734
- X -735
- X -736
- X -737
- X -738
- X -739
- X -740
- X -741
- X -742
- X -743
- X -744
- X -745
- X -746
- X -747
- X -748
- X -749
- X -750
- X -751
- X -753
- X -754
- X -755
- X -756
- X -757
- X -758
- X -759
- X -760
- X -762
- X -764
- X -766
- X -768
- X -769
- X -770
- X -771
- X -772
- X -773
- X -774
- X -777
- X -778
- X -779
- X -780
- X -781
- X -782
- X -783
- X -784
- X -785
- X -786
- X -787
- X -788
- X -789
- X -790
- X -791
- X -793
- X -794
- X -795
- X -796
- X -797
- X -798
- X -799
- X -800
- X -801
- X -802
- X -803
- X -804
- X -805
- X -806
- X -807
- X -808
- X -809
- X -810
- X -811
- X -812
- X -813
- X -814
- X -815
- X -816
- X -817
- X -818
- X -819
- X -820
- X -821
- X -822
- X -823
- X -824
- X -825
- X -826
- X -827
- X -828
- X -829
- X -830
- X -831
- X -832
- X -834
- X -836
- X -837
- X -839
- X -840
- X -842
- X -844
- X -846
- X -847
- X -850
- X -851
- X -853
- X -854
- X -856
- X -857
- X -858
- X -859
- X -861
- X -862
- X -863
- X -864
- X -865
- X -866
- X -867
- X -868
- X -869
- X -870
- X -871
- X -872
- X -873
- X -874
- X -875
- X -876
- X -877
- X -878
- X -879
- X -880
- X -881
- X -883
- X -884
- X -885
- X -887
- X -888
- X -889
- X -890
- X -891
- X -893
- X -894
- X -895
- X -896
- X -897
- X -898
- X -899
- X -900
- X -901
- X -902
- X -903
- X -904
- X -905
- X -906
- X -907
- X -908
- X -909
- X -910
- X -911
- X -912
- X -913
- X -914
- X -915
- X -916
- X -917
- X -918
- X -919
- X -921
- X -924
- X -925
- X -926
- X -927
- X -928
- X -930
- X -931
- X -932
- X -933
- X -934
- X -935
- X -938
- X -941
- X -943
- X -945
- X -949
- X -951
- X -953
- X -955
- X -957
- X -958
- X -959
- X -960
- X -961
- X -963
- X -964
- X -965
- X -966
- X -967
- X -968
- X -969
- X -970
- X -971
- X -972
- X -974
- X -978
- X -981
- X -983
- X -985
- X -987
- X -988
- X -989
- X -990
- X -991
- X -992
- X -993
- X -994
- X -995
- X -996
- X -997
- X -998
- X -999
- X -1000
- X -1003
- X -1005
- X -1007
- X -1008
- X -1009
- X -1010
- X -1011
- X -1012
- X -1013
- X -1014
- X -1015
- X -1019
- X -1025
- X -1028
- X -1029
- X -1030
- X -1033
- X -1037
- X -1039
- X -1040
- X -1041
- X -1042
- X -1048
- X -1049
- X -1050
- X -1051
- X -1052
- X -1054
- X -1055
- X -1056
- X -1058
- X -1059
- X -1060
- X -1061
- X -1062
- X -1064
- X -1065
- X -1066
- X -1067
- X -1068
- X -1069
- X -1070
- X -1071
- X -1072
- X -1073
- X -1074
- X -1075
- X -1076
- X -1077
- X -1078
- X -1079
- X -1080
- X -1081
- X -1082
- X -1083
- X -1084
- X -1088
- X -1093
- X -1098
- X -1099
- X -1101
- X -1102
- X -1103
- X -1125
- X -1127
- X -1129
- X -1132
- X -1134
- X -1136
- X -1141
- X -1142
- X -1143
- X -1144
- X -1145
- X -1146
- X -1147
- X -1148
- X -1149
- X -1152
- X -1156
- X -1161
- X -1164
- X -1166
- X -1168
- X -1169
- X -1171
- X -1176
- X -1187
- X -1188
- X -1189
- X -1190
- X -1191
- X -1192
- X -1193
- X -1194
- X -1195
- X -1198
- X -1200
- X -1201
- X -1204
- X -1208
- X -1218
- X -1229
- X -1230
- X -1231
- X -1232
- X -1233
- X -1234
- X -1235
- X -1236
- X -1237
- X -1238
- X -1239
- X -1241
- X -1242
- X -1243
- X -1244
- X -1246
- X -1250
- X -1252
- X -1255
- X -1256
- X -1260
- X -1261
- X -1262
- X -1263
- X -1264
- X -1265
- X -1266
- X -1267
- X -1268
- X -1269
- X -1270
- X -1271
- X -1272
- X -1273
- X -1274
- X -1275
- X -1276
- X -1277
- X -1278
- X -1280
- X -1281
- X -1296
- X -1297
- X -1299
- X -1300
- X -1302
- X -1303
- X -1304
- X -1305
- X -1306
- X -1307
- X -1308
- X -1309
- X -1310
- X -1311
- X -1312
- X -1313
- X -1314
- X -1315
- X -1316
- X -1317
- X -1318
- X -1319
- X -1320
- X -1321
- X -1329
- X -1330
- X -1331
- X -1332
- X -1333
- X -1334
- X -1335
- X -1336
- X -1337
- X -1338
- X -1339
- X -1340
- X -1341
- X -1342
- X -1343
- X -1344
- X -1345
- X -1346
- X -1347
- X -1348
- X -1349
- X -1350
- X -1351
- X -1352
- X -1353
- X -1354
- X -1355
- X -1356
- X -1357
- X -1359
- X -1361
- X -1362
- X -1363
- X -1364
- X -1368
- X -1371
- X -1372
- X -1373
- X -1374
- X -1375
- X -1376
- X -1377
- X -1378
- X -1379
- X -1382
- X -1383
- X -1384
- X -1385
- X -1386
- X -1387
- X -1389
- X -1390
- X -1391
- X -1392
- X -1393
- X -1394
- X -1395
- X -1396
- X -1397
- X -1398
- X -1399
- X -1400
- X -1401
- X -1402
- X -1403
- X -1404
- X -1405
- X -1407
- X -1408
- X -1409
- X -1410
- X -1414
- X -1417
- X -1418
- X -1419
- X -1420
- X -1422
- X -1423
- X -1424
- X -1425
- X -1427
- X -1429
- X -1430
- X -1431
- X -1432
- X -1433
- X -1442
- X -1443
- X -1444
- X -1445
- X -1446
- X -1447
- X -1449
- X -1450
- X -1451
- X -1452
- X -1453
- X -1454
- X -1455
- X -1456
- X -1457
- X -1458
- X -1459
- X -1460
- X -1461
- X -1462
- X -1463
- X -1464
- X -1465
- X -1466
- X -1467
- X -1468
- X -1469
- X -1470
- X -1471
- X -1472
- X -1473
- X -1474
- X -1475
- X -1476
- X -1477
- X -1478
- X -1479
- X -1480
- X -1481
- X -1482
- X -1483
- X -1484
- X -1485
- X -1486
- X -1487
- X -1488
- X -1489
- X -1490
- X -1491
- X -1492
- X -1493
- X -1494
- X -1495
- X -1496
- X -1497
- X -1498
- X -1499
- X -1500
- X -1501
- X -1502
- X -1503
- X -1504
- X -1505
- X -1506
- X -1507
- X -1509
- X -1510
- X -1511
- X -1512
- X -1513
- X -1514
- X -1515
- X -1517
- X -1519
- X -1520
- X -1521
- X -1522
- X -1524
- X -1526
- X -1527
- X -1528
- X -1529
- X -1530
- X -1531
- X -1532
- X -1533
- X -1534
- X -1536
- X -1537
- X -1538
- X -1539
- X -1540
- X -1541
- X -1542
- X -1543
- X -1544
- X -1545
- X -1546
- X -1547
- X -1549
- X -1550
- X -1552
- X -1553
- X -1554
- X -1555
- X -1556
- X -1557
- X -1558
- X -1559
- X -1560
- X -1562
- X -1563
- X -1564
- X -1565
- X -1566
- X -1568
- X -1569
- X -1571
- X -1572
- X -1573
- X -1574
- X -1576
- X -1578
- X -1580
- X -1581
- X -1583
- X -1585
- X -1586
- X -1587
- X -1589
- X -1591
- X -1592
- X -1594
- X -1596
- X -1597
- X -1599
- X -1601
- X -1602
- X -1604
- X -1606
- X -1607
- X -1608
- X -1609
- X -1611
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- X 0
- END_OF_rtext.dat
- if test 9450 -ne `wc -c <rtext.dat`; then
- echo shar: \"rtext.dat\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- echo shar: End of archive 5 \(of 7\).
- cp /dev/null ark5isdone
- MISSING=""
- for I in 1 2 3 4 5 6 7 ; do
- if test ! -f ark${I}isdone ; then
- MISSING="${MISSING} ${I}"
- fi
- done
- if test "${MISSING}" = "" ; then
- echo You have unpacked all 7 archives.
- rm -f ark[1-9]isdone
- else
- echo You still need to unpack the following archives:
- echo " " ${MISSING}
- fi
- ## End of shell archive.
- exit 0
-